home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / site / DBI / W32ODBC.pm < prev   
Encoding:
Perl POD Document  |  1999-12-28  |  2.8 KB  |  155 lines
  1. package DBI;
  2.  
  3.  
  4. =head1 NAME
  5.  
  6. DBI::W32ODBC - An experimental DBI emulation layer for Win32::ODBC
  7.  
  8. =head1 SYNOPSIS
  9.  
  10.   use DBI::W32ODBC;
  11.  
  12.  
  13.   $dbh = DBI->connect(...);
  14.  
  15.   $rc  = $dbh->do($statement);
  16.  
  17.   $sth = $dbh->prepare($statement);
  18.  
  19.   $rc = $sth->execute;
  20.  
  21.   @row_ary = $sth->fetchrow;
  22.   $row_ref = $sth->fetch;
  23.  
  24.   $rc = $sth->finish;
  25.  
  26.   $rv = $sth->rows;
  27.  
  28.   $rc = $dbh->disconnect;
  29.  
  30.   $sql = $dbh->quote($string);
  31.  
  32.   $rv  = $h->err;
  33.   $str = $h->errstr;
  34.  
  35. =head1 DESCRIPTION
  36.  
  37. THIS IS A VERY EXPERIMENTAL PURE PERL DBI EMULATION LAYER FOR Win32::ODBC
  38.  
  39. It was developed for use with an Access database and the quote() method
  40. is very likely to need reworking.
  41.  
  42. If you can improve this code I'd be interested in hearing out it. If
  43. you are having trouble using it please respect the fact that it's very
  44. experimental.
  45.  
  46. =cut
  47.  
  48. $VERSION = $VERSION = '0.01';
  49. my $Revision = substr(q$Revision: 1.3 $, 10);
  50.  
  51. sub DBI::W32ODBC::import { }        # must trick here since we're called DBI/W32ODBC.pm
  52.  
  53.  
  54. use Carp;
  55.  
  56. use Win32::ODBC;
  57.  
  58. @ISA = qw(Win32::ODBC);
  59.  
  60. use strict;
  61.  
  62. $DBI::dbi_debug = $ENV{PERL_DBI_DEBUG} || 0;
  63. carp "Loaded DBI.pm (debug $DBI::dbi_debug)" if $DBI::dbi_debug;
  64.  
  65.  
  66.  
  67. sub connect {
  68.     my ($class, $dbname, $dbuser, $dbpasswd, $module, $attr) = @_;
  69.     $dbname .= ";UID=$dbuser"   if $dbuser;
  70.     $dbname .= ";PWD=$dbpasswd" if $dbpasswd;
  71.     my $h = new Win32::ODBC $dbname;
  72.     warn "Error connecting to $dbname: ".Win32::ODBC::Error()."\n" unless $h;
  73.     bless $h, $class if $h;    # rebless into our class
  74.     $h;
  75. }
  76.  
  77.  
  78. sub quote {
  79.     my ($h, $string) = @_;
  80.     $string =~ s/'/''/g;
  81.     $string =~ s/\r/' & chr\$(13) & '/g;
  82.     $string =~ s/\n/' & chr\$(10) & '/g;
  83.     "'$string'";
  84. }
  85.  
  86. sub do {
  87.     my($h, $statement, $attribs, @params) = @_;
  88.     Carp::carp "\$h->do() attribs unused\n" if $attribs;
  89.     $h = $h->prepare($statement) or return undef;
  90.     $h->execute(@params) or return undef;
  91.     my $rows = $h->rows;
  92.     ($rows == 0) ? "0E0" : $rows;
  93. }
  94.  
  95.  
  96. sub prepare {
  97.     my ($h, $sql) = @_;
  98.     $h->{'__prepare'} = $sql;
  99.     $h->{NAME} = [];
  100.     $h->{NUM_OF_FIELDS} = -1;
  101.     return $h;
  102. }
  103.  
  104. sub execute {
  105.     my ($h) = @_;
  106.     my $rc = $h->Sql($h->{'__prepare'});
  107.     return undef if $rc;
  108.     my @fields = $h->FieldNames;
  109.     $h->{NAME} = \@fields;
  110.     $h->{NUM_OF_FIELDS} = scalar @fields;
  111.     $h;    # return dbh as pseudo sth
  112. }
  113.  
  114. sub fetchrow {
  115.     my $h = shift;
  116.     return () unless $h->FetchRow();
  117.     my $fields_r = $h->{NAME};
  118.     $h->Data(@$fields_r);
  119. }
  120.  
  121. sub fetch {
  122.     my @row = shift->fetchrow;
  123.     return undef unless @row;
  124.     return \@row;
  125. }
  126.  
  127. sub rows {
  128.     shift->RowCount;
  129. }
  130.  
  131. sub finish {
  132. }
  133.  
  134.  
  135. sub commit {
  136.     undef;
  137. }
  138. sub rollback {
  139.     undef;
  140. }
  141.  
  142. sub disconnect {
  143.     shift->Close
  144. }
  145.  
  146. sub err {
  147.     (shift->Error)[0];
  148. }
  149. sub errstr {
  150.     scalar( shift->Error );
  151. }
  152.  
  153.  
  154. 1;
  155.